C   IMSL ROUTINE NAME   - LUDATN                                        LUDN0010
C                                                                       LUDN0020
C-----------------------------------------------------------------------LUDN0030
C                                                                       LUDN0040
C   COMPUTER            - HP1000/SINGLE                                 LUDN0050
C                                                                       LUDN0060
C   LATEST REVISION     - JUNE 1, 1982                                  LUDN0070
C                                                                       LUDN0080
C   PURPOSE             - NUCLEUS CALLED ONLY BY IMSL SUBROUTINE LEQT2F LUDN0090
C                                                                       LUDN0100
C   PRECISION/HARDWARE  - SINGLE AND DOUBLE/H32                         LUDN0110
C                       - SINGLE/H36,H48,H60                            LUDN0120
C                                                                       LUDN0130
C   REQD. IMSL ROUTINES - UERTST,UGETIO                                 LUDN0140
C                                                                       LUDN0150
C   NOTATION            - INFORMATION ON SPECIAL NOTATION AND           LUDN0160
C                           CONVENTIONS IS AVAILABLE IN THE MANUAL      LUDN0170
C                           INTRODUCTION OR THROUGH IMSL ROUTINE UHELP  LUDN0180
C                                                                       LUDN0190
C   COPYRIGHT           - 1982 BY IMSL, INC. ALL RIGHTS RESERVED.       LUDN0200
C                                                                       LUDN0210
C   WARRANTY            - IMSL WARRANTS ONLY THAT IMSL TESTING HAS BEEN LUDN0220
C                           APPLIED TO THIS CODE. NO OTHER WARRANTY,    LUDN0230
C                           EXPRESSED OR IMPLIED, IS APPLICABLE.        LUDN0240
C                                                                       LUDN0250
C-----------------------------------------------------------------------LUDN0260
C                                                                       LUDN0270
      SUBROUTINE LUDATN (A,IA,N,LU,ILU,IDGT,D1,D2,APVT,EQUIL,WA,IER)    LUDN0280
C                                                                       LUDN0290
      DIMENSION          A(IA,1),LU(ILU,1),APVT(1),EQUIL(1)             LUDN0300
      REAL               LU                                             LUDN0310
      DATA               ZERO,ONE,FOUR,SIXTN,SIXTH/0.0,1.,4.,16.,.0625/ LUDN0320
C                                  FIRST EXECUTABLE STATEMENT           LUDN0330
C                                  INITIALIZATION                       LUDN0340
      IER = 0                                                           LUDN0350
      RN = N                                                            LUDN0360
      WREL = ZERO                                                       LUDN0370
      D1 = ONE                                                          LUDN0380
      D2 = ZERO                                                         LUDN0390
      BIGA = ZERO                                                       LUDN0400
      DO 10 I=1,N                                                       LUDN0410
         BIG = ZERO                                                     LUDN0420
         DO 5 J=1,N                                                     LUDN0430
            P = A(I,J)                                                  LUDN0440
            LU(I,J) = P                                                 LUDN0450
            P = ABS(P)                                                  LUDN0460
            IF (P .GT. BIG) BIG = P                                     LUDN0470
    5    CONTINUE                                                       LUDN0480
         IF (BIG .GT. BIGA) BIGA = BIG                                  LUDN0490
         IF (BIG .EQ. ZERO) GO TO 110                                   LUDN0500
         EQUIL(I) = ONE/BIG                                             LUDN0510
   10 CONTINUE                                                          LUDN0520
      DO 105 J=1,N                                                      LUDN0530
         JM1 = J-1                                                      LUDN0540
         IF (JM1 .LT. 1) GO TO 40                                       LUDN0550
C                                  COMPUTE U(I,J), I=1,...,J-1          LUDN0560
         DO 35 I=1,JM1                                                  LUDN0570
            SUM = LU(I,J)                                               LUDN0580
            IM1 = I-1                                                   LUDN0590
            IF (IDGT .EQ. 0) GO TO 25                                   LUDN0600
C                                  WITH ACCURACY TEST                   LUDN0610
            AI = ABS(SUM)                                               LUDN0620
            WI = ZERO                                                   LUDN0630
            IF (IM1 .LT. 1) GO TO 20                                    LUDN0640
            DO 15 K=1,IM1                                               LUDN0650
               T = LU(I,K)*LU(K,J)                                      LUDN0660
               SUM = SUM-T                                              LUDN0670
               WI = WI+ABS(T)                                           LUDN0680
   15       CONTINUE                                                    LUDN0690
            LU(I,J) = SUM                                               LUDN0700
   20       WI = WI+ABS(SUM)                                            LUDN0710
            IF (AI .EQ. ZERO) AI = BIGA                                 LUDN0720
            TEST = WI/AI                                                LUDN0730
            IF (TEST .GT. WREL) WREL = TEST                             LUDN0740
            GO TO 35                                                    LUDN0750
C                                  WITHOUT ACCURACY                     LUDN0760
   25       IF (IM1 .LT. 1) GO TO 35                                    LUDN0770
            DO 30 K=1,IM1                                               LUDN0780
               SUM = SUM-LU(I,K)*LU(K,J)                                LUDN0790
   30       CONTINUE                                                    LUDN0800
            LU(I,J) = SUM                                               LUDN0810
   35    CONTINUE                                                       LUDN0820
   40    P = ZERO                                                       LUDN0830
C                                  COMPUTE U(J,J) AND L(I,J), I=J+1,...,LUDN0840
         DO 70 I=J,N                                                    LUDN0850
            SUM = LU(I,J)                                               LUDN0860
            IF (IDGT .EQ. 0) GO TO 55                                   LUDN0870
C                                  WITH ACCURACY TEST                   LUDN0880
            AI = ABS(SUM)                                               LUDN0890
            WI = ZERO                                                   LUDN0900
            IF (JM1 .LT. 1) GO TO 50                                    LUDN0910
            DO 45 K=1,JM1                                               LUDN0920
               T = LU(I,K)*LU(K,J)                                      LUDN0930
               SUM = SUM-T                                              LUDN0940
               WI = WI+ABS(T)                                           LUDN0950
   45       CONTINUE                                                    LUDN0960
            LU(I,J) = SUM                                               LUDN0970
   50       WI = WI+ABS(SUM)                                            LUDN0980
            IF (AI .EQ. ZERO) AI = BIGA                                 LUDN0990
            TEST = WI/AI                                                LUDN1000
            IF (TEST .GT. WREL) WREL = TEST                             LUDN1010
            GO TO 65                                                    LUDN1020
C                                  WITHOUT ACCURACY TEST                LUDN1030
   55       IF (JM1 .LT. 1) GO TO 65                                    LUDN1040
            DO 60 K=1,JM1                                               LUDN1050
               SUM = SUM-LU(I,K)*LU(K,J)                                LUDN1060
   60       CONTINUE                                                    LUDN1070
            LU(I,J) = SUM                                               LUDN1080
   65       Q = EQUIL(I)*ABS(SUM)                                       LUDN1090
            IF (P .GE. Q) GO TO 70                                      LUDN1100
            P = Q                                                       LUDN1110
            IMAX = I                                                    LUDN1120
   70    CONTINUE                                                       LUDN1130
C                                  TEST FOR ALGORITHMIC SINGULARITY     LUDN1140
         Q = RN+P                                                       LUDN1150
   71    IF (Q .EQ. RN) GO TO 110                                       LUDN1160
         IF (J .EQ. IMAX) GO TO 80                                      LUDN1170
C                                  INTERCHANGE ROWS J AND IMAX          LUDN1180
         D1 = -D1                                                       LUDN1190
         DO 75 K=1,N                                                    LUDN1200
            P = LU(IMAX,K)                                              LUDN1210
            LU(IMAX,K) = LU(J,K)                                        LUDN1220
            LU(J,K) = P                                                 LUDN1230
   75    CONTINUE                                                       LUDN1240
         EQUIL(IMAX) = EQUIL(J)                                         LUDN1250
   80    APVT(J) = IMAX                                                 LUDN1260
         D1 = D1*LU(J,J)                                                LUDN1270
   85    IF (ABS(D1) .LE. ONE) GO TO 90                                 LUDN1280
         D1 = D1*SIXTH                                                  LUDN1290
         D2 = D2+FOUR                                                   LUDN1300
         GO TO 85                                                       LUDN1310
   90    IF (ABS(D1) .GE. SIXTH) GO TO 95                               LUDN1320
         D1 = D1*SIXTN                                                  LUDN1330
         D2 = D2-FOUR                                                   LUDN1340
         GO TO 90                                                       LUDN1350
   95    CONTINUE                                                       LUDN1360
         JP1 = J+1                                                      LUDN1370
         IF (JP1 .GT. N) GO TO 105                                      LUDN1380
C                                  DIVIDE BY PIVOT ELEMENT U(J,J)       LUDN1390
         P = LU(J,J)                                                    LUDN1400
         DO 100 I=JP1,N                                                 LUDN1410
            LU(I,J) = LU(I,J)/P                                         LUDN1420
  100    CONTINUE                                                       LUDN1430
  105 CONTINUE                                                          LUDN1440
C                                  PERFORM ACCURACY TEST                LUDN1450
      IF (IDGT .EQ. 0) GO TO 9005                                       LUDN1460
      P = 3*N+3                                                         LUDN1470
      WA = P*WREL                                                       LUDN1480
      Q = WA+10.0**(-IDGT)                                              LUDN1490
  106 IF (Q .NE. WA) GO TO 9005                                         LUDN1500
      IER = 34                                                          LUDN1510
      GO TO 9000                                                        LUDN1520
C                                  ALGORITHMIC SINGULARITY              LUDN1530
  110 IER = 129                                                         LUDN1540
      D1 = ZERO                                                         LUDN1550
      D2 = ZERO                                                         LUDN1560
 9000 CONTINUE                                                          LUDN1570
C                                  PRINT ERROR                          LUDN1580
      CALL UERTST(IER,'LUDATN')                                         LUDN1590
 9005 RETURN                                                            LUDN1600
      END                                                               LUDN1610
